home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / boot / history.pl < prev    next >
Encoding:
Text File  |  1997-10-28  |  8.5 KB  |  291 lines
  1. /*  $Id: history.pl,v 1.10 1997/10/28 13:40:27 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: implementation of history system
  7. */
  8.  
  9. :- module($history,
  10.     [ read_history/6
  11.     , $clean_history/0
  12.     ]).
  13.  
  14. %   read_history(+History, +Help, +DontStore, +Prompt, -Term, -Bindings)
  15. %   Give a prompt using Prompt. The sequence '%w' is substituted with the
  16. %   current event number. Then read a term from the input stream and perform
  17. %   the history expansion. Return the expanded term and the bindings of the
  18. %   variables as with read/2.
  19. %   entering the term History makes read_history/5 print the history.
  20. %   Help specifies the help command.
  21. %   DontStore is a list of events that need not be stored.
  22.  
  23. %   When read_history reads a term of the form $silent(Goal), it will
  24. %   call Goal and pretend it has not seen anything.  This hook is used
  25. %   by the GNU-Emacs interface to for communication between GNU-EMACS
  26. %   and SWI-Prolog.
  27.  
  28. read_history(History, Help, DontStore, Prompt, Term, Bindings) :-
  29.     repeat, 
  30.         prompt_history(Prompt), 
  31.         $raw_read(Raw), 
  32.         read_history_(History, Help, DontStore, Raw, Term, Bindings), !.
  33.  
  34. read_history_(History, _, _, History, _, _) :-
  35.     list_history, !, 
  36.     fail.
  37. read_history_(Show, Help, _, Help, _, _) :-
  38.     help_history(Show, Help), !, 
  39.     fail.
  40. read_history_(History, Help, DontStore, Raw, Term, Bindings) :-
  41.     expand_history(Raw, Expanded, Changed), 
  42.     save_history_line(Expanded),
  43.     $term_to_atom(Term0, Expanded, Bindings0, 1),
  44.     (   var(Term0)
  45.     ->  Term = Term0,
  46.         Bindings = Bindings0
  47.     ;   Term0 = $silent(Goal)
  48.     ->  user:ignore(Goal),
  49.         $raw_read(NewRaw),
  50.         read_history_(History, Help, DontStore, NewRaw, Term, Bindings)
  51.     ;   save_event(DontStore, Expanded), 
  52.         write_event(Expanded, Changed), 
  53.         Term = Term0,
  54.         Bindings = Bindings0
  55.     ).
  56.  
  57.  
  58. write_event(_, false) :- !.
  59. write_event(Event, true) :-
  60.     format('~w.~n', [Event]).
  61.  
  62. %   list_history
  63. %   Write history events to the current output stream.
  64.  
  65. list_history :-
  66.     flag($last_event, Last, Last), 
  67.     history_depth_(Depth), 
  68.     plus(First, Depth, Last), 
  69.     between(First, Last, Nr), 
  70.         recorded($history_list, Nr/Event), 
  71.         format('~t~w   ~8|~w.~n', [Nr, Event]), 
  72.     fail.
  73. list_history.
  74.  
  75. $clean_history :-
  76.     recorded($history_list, _, Ref),
  77.         erase(Ref),
  78.     fail.
  79. $clean_history :-
  80.     flag($last_event, _, 0).
  81.  
  82. help_history(Show, Help) :-
  83.     $ttyformat('History Commands:~n'), 
  84.     $ttyformat('    !!.              Repeat last query~n'), 
  85.     $ttyformat('    !nr.             Repeat query numbered <nr>~n'), 
  86.     $ttyformat('    !str.            Repeat last query starting with <str>~n'), 
  87.     $ttyformat('    !?str.           Repeat last query holding <str>~n'), 
  88.     $ttyformat('    ^old^new.        Substitute <old> into <new> of last query~n'), 
  89.     $ttyformat('    !nr^old^new.     Substitute in query numbered <nr>~n'), 
  90.     $ttyformat('    !str^old^new.    Substitute in query starting with <str>~n'), 
  91.     $ttyformat('    !?str^old^new.   Substitute in query holding <str>~n'), 
  92.     $ttyformat('    ~w.~21|Show history list~n', [Show]), 
  93.     $ttyformat('    ~w.~21|Show this list~n', [Help]).
  94.  
  95. %   prompt_history(+Prompt)
  96. %   Give prompt, substituting '%!' by the event number.
  97.  
  98. prompt_history(Prompt) :-
  99.     flag($last_event, Old, Old), 
  100.     succ(Old, This), 
  101.     name(Prompt, SP),
  102.     name(This, ST),
  103.     (   substitute("%!", ST, SP, String)
  104.     ->  prompt1(String)
  105.     ;   prompt1(Prompt)
  106.     ),
  107.     ttyflush.
  108.  
  109. %   save_event(+Event)
  110. %   Save Event in the history system. Remove possibly outdated events.
  111.  
  112. save_history_line(Line) :-
  113.     feature(readline, true),
  114.     string_concat(Line, '.', CompleteLine),
  115.     call(rl_add_history(CompleteLine)), !.
  116. save_history_line(_).
  117.  
  118. save_event(Dont, Event) :-
  119.     memberchk(Event, Dont), !.
  120. save_event(_, Event) :-
  121.     flag($last_event, Old, Old), 
  122.     succ(Old, New), 
  123.     flag($last_event, _, New), 
  124.     recorda($history_list, New/Event), 
  125.     history_depth_(Depth), 
  126.     remove_history(New, Depth).
  127.  
  128. remove_history(New, Depth) :-
  129.     New - Depth =< 0, !.
  130. remove_history(New, Depth) :-
  131.     Remove is New - Depth,
  132.     recorded($history_list, Remove/_, Ref), !,
  133.     erase(Ref).
  134. remove_history(_, _).    
  135.  
  136. %    history_depth_(-Depth)
  137. %    Define the depth to which to keep the history.
  138.  
  139. history_depth_(N) :-
  140.     feature(history, N), !.
  141. history_depth_(15).
  142.  
  143. %    expand_history(+Raw, -Expanded)
  144. %    Expand Raw using the available history list. Expandations performed
  145. %    are:
  146. %    
  147. %    ^old^new    % Substitute
  148. %    !match        % Last event starting <match>
  149. %    !?match        % Last event matching <match>
  150. %    !n        % Event nr. <n>
  151. %    !spec^old^new    % substitute <by> <new> in last event <spec>
  152. %    !!        % last event
  153. %    
  154. %    Note: the first character after a '!' should be a letter or number to
  155. %    avoid problems with the cut.
  156.  
  157. expand_history(Raw, Expanded, Changed) :-
  158.     name(Raw, RawString), 
  159.     expand_history2(RawString, ExpandedString, Changed), 
  160.     atom_chars(Expanded, ExpandedString), !.
  161.  
  162. expand_history2([0'^|Rest], Expanded, true) :- !, 
  163.     get_last_event(Last), 
  164.     old_new(Rest, Old, New, []), 
  165.     substitute_warn(Old, New, Last, Expanded).
  166. expand_history2(String, Expanded, Changed) :-
  167.     expand_history3(String, Expanded, Changed).
  168.  
  169. expand_history3([0'!, C|Rest], [0'!|Expanded], Changed) :-
  170.     not_event_char(C), !, 
  171.     expand_history3([C|Rest], Expanded, Changed).
  172. expand_history3([0'!|Rest], Expanded, true) :- !, 
  173.     match_event(Rest, Event, NewRest), 
  174.     append(Event, RestExpanded, Expanded), !, 
  175.     expand_history3(NewRest, RestExpanded, _).
  176. expand_history3([H|T], [H|R], Changed) :- !, 
  177.     expand_history3(T, R, Changed).
  178. expand_history3([], [], false).
  179.  
  180. %   old_new(+Spec, -Old, -New, -Left)
  181. %   Takes Spec as a substitute specification without the first '^' and
  182. %   returns the Old and New substitute patterns as well s possible text
  183. %   left.
  184.  
  185. old_new([0'^|Rest], [], New, Left) :- !, 
  186.     new(Rest, New, Left).
  187. old_new([H|Rest], [H|Old], New, Left) :-
  188.     old_new(Rest, Old, New, Left).
  189.  
  190. new([], [], []) :- !.
  191. new([0'^|Left], [], Left) :- !.
  192. new([H|T], [H|New], Left) :-
  193.     new(T, New, Left).
  194.  
  195. %   get_last_event(-String)
  196. %   return last event typed as a string
  197.  
  198. get_last_event(Event) :-
  199.     recorded($history_list, _/Atom), 
  200.     name(Atom, Event), !.
  201. get_last_event(_) :-
  202.     $ttyformat('! No such event~n'),
  203.     fail.
  204.  
  205. %   substitute(+Old, +New, +String, -Substituted)    
  206. %   substitute first occurence of Old in String by New
  207.  
  208. substitute(Old, New, String, Substituted) :-
  209.     append(Head, OldAndTail, String), 
  210.     append(Old, Tail, OldAndTail), !, 
  211.     append(Head, New, HeadAndNew), 
  212.     append(HeadAndNew, Tail, Substituted), !.
  213.  
  214. substitute_warn(Old, New, String, Substituted) :-
  215.     substitute(Old, New, String, Substituted), !.
  216. substitute_warn(_, _, _, _) :-
  217.     $ttyformat('! bad substitution~n'),
  218.     fail.
  219.  
  220. %   match_event(+Spec, -Event, -Rest)
  221. %   Use Spec as a specification of and event and return the event as Event
  222. %   and what is left of Spec as Rest.
  223.  
  224. match_event(Spec, Event, Rest) :-
  225.     find_event(Spec, RawEvent, Rest0), !, 
  226.     substitute_event(Rest0, RawEvent, Event, Rest).
  227. match_event(_, _, _) :-
  228.     $ttyformat('! No such event~n'),
  229.     fail.
  230.  
  231. substitute_event([0'^|Spec], RawEvent, Event, Rest) :- !, 
  232.     old_new(Spec, Old, New, Rest), 
  233.     substitute(Old, New, RawEvent, Event).
  234. substitute_event(Rest, Event, Event, Rest).
  235.  
  236. alpha(C) :- between(0'a, 0'z, C).
  237. alpha(C) :- between(0'A, 0'Z, C).
  238. alpha(0'_).
  239.  
  240. digit(C) :- between(0'0, 0'9, C).
  241.  
  242. alpha_digit(C) :-
  243.     alpha(C).
  244. alpha_digit(C) :-
  245.     digit(C).
  246.  
  247. not_event_char(C) :- alpha_digit(C), !, fail.
  248. not_event_char(0'?) :- !, fail.
  249. not_event_char(0'!) :- !, fail.
  250. not_event_char(_).
  251.  
  252. find_event([0'?|Rest], Event, Left) :- !, 
  253.     take_string(Rest, String, Left), 
  254.     matching_event(substring, String, Event).
  255. find_event([0'!|Left], Event, Left) :- !, 
  256.     get_last_event(Event).
  257. find_event([N|Rest], Event, Left) :-
  258.     digit(N), !, 
  259.     take_number([N|Rest], String, Left), 
  260.     name(Number, String), 
  261.     recorded($history_list, Number/Atom), 
  262.     name(Atom, Event).
  263. find_event(Spec, Event, Left) :-
  264.     take_string(Spec, String, Left), 
  265.     matching_event(prefix, String, Event).
  266.  
  267. take_string([C|Rest], [C|String], Left) :-
  268.     alpha_digit(C), !, 
  269.     take_string(Rest, String, Left).
  270. take_string([C|Rest], [], [C|Rest]) :- !.    
  271. take_string([], [], []).
  272.     
  273. take_number([C|Rest], [C|String], Left) :-
  274.     digit(C), !, 
  275.     take_string(Rest, String, Left).
  276. take_number([C|Rest], [], [C|Rest]) :- !.    
  277. take_number([], [], []).
  278.  
  279. %   matching_event(+Where, +String, -Event)
  280. %   Return first event with prefix String as a Prolog string.
  281.  
  282. matching_event(prefix, String, Event) :-
  283.     recorded($history_list, _/AtomEvent), 
  284.     name(AtomEvent, Event), 
  285.     append(String, _, Event), !.
  286. matching_event(substring, String, Event) :-
  287.     recorded($history_list, _/AtomEvent), 
  288.     name(AtomEvent, Event), 
  289.     append(_, MatchAndTail, Event), 
  290.     append(String, _, MatchAndTail), !.    
  291.